home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
pnl003.zip
/
TEXTLIST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-05-22
|
5KB
|
222 lines
Unit TextList;
{*****************************************************************************
* This unit creates a basic list of text strings. It uses TP 5.5's object *
* oriented features for program extensibility. *
*****************************************************************************}
Interface
Const
MaximumTextSize = 65; {Set this to the maximum text string size}
Type
TextString = string[MaximumTextSize];
TextPointer = ^TextRecord;
TextRecord = Record {This is the main list record}
P , {Pointer to previous record}
N : TextPointer; {Pointer to next record }
S : TextString; {The text value }
End;
TextObject = Object
{These are the Object's variables}
FirstRec, {Pointer to top of list }
LastRec , {Pointer to bottom of list }
ThisRec : TextPointer; {Pointer to current list item }
EOFRec , {TRUE if attempt to go below last item }
TOFRec : boolean; {TRUE if attempt to go above first item}
NoRecs , {Number of records in list }
RecNo : integer; {Relative number of current list item}
{These are the Object's methods}
Procedure Init ;
Procedure Done ;
Procedure AddRec (T : TextString);
Procedure DelRec ;
Procedure ChgRec (T : TextString);
Function GetRec : TextString;
Procedure TopRec ;
Procedure BottomRec ;
Procedure UpRec (I : word);
Procedure DownRec (I : word);
End;
Implementation
Procedure TextObject.Init;
{Initialization routine. Setup the list parameters.}
Begin
FirstRec := Nil;
LastRec := Nil;
ThisRec := Nil;
EOFRec := True;
TOFRec := True;
NoRecs := 0;
RecNo := 0;
End;
Procedure TextObject.Done;
{Termination routine. Deallocate the list and reset the parameters.}
Begin
ThisRec := FirstRec;
While ThisRec <> Nil Do
Begin
FirstRec := FirstRec^.N;
Dispose(ThisRec);
ThisRec := FirstRec;
End;
LastRec := Nil;
EOFRec := True;
TOFRec := True;
NoRecs := 0;
RecNo := 0;
End;
Procedure TextObject.AddRec (T : TextString);
{Add a new list item below the current item}
Var
R : TextPointer;
Begin
New(R);
Inc(NoRecs);
Inc(RecNo);
EOFRec := False;
TOFRec := False;
R^.S := T;
If FirstRec = Nil Then
Begin
FirstRec := R;
R^.P := Nil;
R^.N := Nil;
End
Else
Begin
R^.N := ThisRec^.N;
R^.P := ThisRec;
ThisRec^.N := R;
End;
If R^.N = Nil Then
LastRec := R
Else
R^.N^.P := R;
ThisRec := R;
End;
Procedure TextObject.DelRec;
{Delete the current list item}
Var
R : TextPointer;
Begin
If ThisRec <> Nil Then
Begin
R := ThisRec;
ThisRec := R^.N;
If R^.P = Nil Then
FirstRec := R^.N
Else
R^.P^.N := R^.N;
If R^.N = Nil Then
Begin
LastRec := R^.P;
ThisRec := R^.P;
EOFRec := True;
Dec(RecNo);
End
Else
R^.N^.P := R^.P;
Dispose(R);
Dec(NoRecs);
End;
End;
Procedure TextObject.ChgRec(T : TextString);
{Change the text value of the current list item}
Begin
If ThisRec <> Nil Then
ThisRec^.S := T;
End;
Function TextObject.GetRec : TextString;
{Return the text value of the current list item}
Begin
If ThisRec <> Nil Then
GetRec := ThisRec^.S
Else
GetRec := '<<EMPTY>>';
End;
Procedure TextObject.TopRec;
{Move to the top-most list item}
Begin
ThisRec := FirstRec;
If ThisRec <> Nil Then
Begin
EOFRec := False;
TOFRec := False;
RecNo := 1;
End
Else {the list is empty}
Begin
EOFRec := True;
TOFRec := True;
RecNo := 0;
End;
End;
Procedure TextObject.BottomRec;
{Move to the bottom-most list item}
Begin
ThisRec := LastRec;
If ThisRec <> Nil Then
Begin
EOFRec := False;
TOFRec := False;
RecNo := NoRecs;
End
Else {the list is empty}
Begin
RecNo := 0;
EOFRec := True;
TOFRec := True;
End;
End;
Procedure TextObject.UpRec (I : word);
{Move up the list 'I' items}
Var
J : word;
Begin
J := I;
While (J > 0) and (ThisRec <> FirstRec) Do
Begin
ThisRec := ThisRec^.P;
Dec(J);
Dec(RecNo);
End;
TOFRec := J > 0;
EOFRec := ThisRec = Nil;
End;
Procedure TextObject.DownRec (I : word);
{Move down the list 'I' items}
Var
J : word;
Begin
J := I;
While (J > 0) and (ThisRec <> LastRec) Do
Begin
ThisRec := ThisRec^.N;
Dec(J);
Inc(RecNo);
End;
EOFRec := J > 0;
TOFRec := ThisRec = Nil;
End;
Begin
End.